
(cond-expand
 (modules
  (import (chibi) (chibi iset) (chibi iset optimize) (srfi 1) (chibi test)))
 (else #f))

(define (test-name iset op)
  (call-with-output-string
    (lambda (out)
      (let* ((ls (iset->list iset))
             (ls (if (> (length ls) 10)
                     `(,@(take ls 5) ... ,@(take-right ls 5))
                     ls)))
        (write `(,(car op) (iset ,@ls) ,@(cdr op)) out)))))

(test-begin "iset")

(let ((tests
       `((() (+ 99) (u 3 50) (? 99))
         (() (u 1) (u 1000) (u -1000) (u 3) (u -1))
         ((17 29) (u 7 29))
         ((2 3 4) (u 1 2 3 4 5))
         ((1 2 3 4 5) (u 2 3 4))
         ((0) (z #f) (- 0) (z))
         ((0 1 2) (- 1) (- 2) (? 0))
         ((1 2 3 1000 2000) (u 1 4))
         ((1 2 3 1000 1005))
         ((97308 97827 97845 97827))
         ((1 128 127))
         ((129 2 127))
         ((1 -128 -126))
         (() (u: 349 680) (u: 682 685))
         (() (u: 64434 64449) (u: 65020 65021) (u #xFE62))
         (() (u: 716 747) (u: 750 1084))
         (() (u: 48 57) (u: 65 90) (u: 97 122) (u 45 46 95 126) (? 119))
         )))
  (for-each
   (lambda (tst)
     (let* ((ls (car tst))
            (is (list->iset ls))
            (ls2 (delete-duplicates ls =)))
       ;; initial creation and sanity checks
       (test-assert (lset= equal? ls2 (iset->list is)))
       (test (length ls2) (iset-size is))
       (for-each
        (lambda (x) (test-assert (iset-contains? is x)))
        ls)
       (test (iset-contains? is 42) (member 42 ls))
       ;; additional operations
       (for-each
        (lambda (op)
          (let ((name (test-name is op)))
            (case (car op)
              ((+)
               (iset-adjoin! is (cadr op))
               (test-assert name (iset-contains? is (cadr op))))
              ((-)
               (iset-delete! is (cadr op))
               (test-assert name (not (iset-contains? is (cadr op)))))
              ((?)
               (test name (if (pair? (cddr op)) (car (cddr op)) #t)
                 (iset-contains? is (cadr op))))
              ((d)
               (set! is (iset-difference is (list->iset (cdr op))))
               (for-each (lambda (x) (test-assert name (iset-contains? is x)))
                         (cdr op)))
              ((i) (set! is (iset-intersection is (list->iset (cdr op)))))
              ((s) (test (iset-size is) (cadr op)))
              ((u u:)
               (let ((arg (cond ((eq? 'u: (car op))
                                 (make-iset (cadr op) (car (cddr op))))
                                ((iset? (cadr op)) (cadr op))
                                (else (list->iset (cdr op))))))
                 (set! is (iset-union is arg)))
               (for-each
                (lambda (x)
                  (if (integer? x)
                      (test-assert name (iset-contains? is x))))
                (cdr op)))
              ((z) (test (iset-empty? is) (if (pair? (cdr op)) (cadr op) #t)))
              (else (error "unknown operation" (car op))))))
        (cdr tst))
       ;; optimization
       (let* ((is2 (iset-optimize is))
              (is3 (iset-balance is))
              (is4 (iset-balance is2)))
         (test-assert (iset= is is2))
         (test-assert (iset= is is3))
         (test-assert (iset= is is4)))))
   tests))

(let ((a (%make-iset 65 90 #f #f (%make-iset 97 122 #f #f #f)))
      (b (list->iset '(45 46 95 126))))
  (test-assert (iset-contains? (iset-union a b) 119))
  (test-assert (iset-contains? (iset-union b a) 119))) 

(test '(2 3 4)
    (iset->list (iset-map (lambda (i) (+ i 1)) (iset 1 2 3))))

(test-assert (iset<= (iset 97) (iset 97 117)))
(test-assert (iset<= (iset 117) (iset 97 117)))

(test-assert (iset= (iset-union (iset 1 3) (iset 3 4)) (iset 1 3 4)))
(test-assert (iset= (iset-union (iset 3) (iset 1 3)) (iset 1 3)))
(test-assert (iset= (iset-union (iset 1 4) (iset 3 4 5)) (iset 1 3 4 5)))

(test '(1 2 3 4 5 6 7 8) (iset->list (iset 1 2 3 4 5 6 7 8)))
(test '(1 3 4 5 6 7 8) (iset->list (iset 1 3 4 5 6 7 8)))
(test '(1 2 4 5 6 7 8) (iset->list (iset 1 2 4 5 6 7 8)))
(test '(1 2 3 5 6 7 8) (iset->list (iset 1 2 3 5 6 7 8)))
(test '(1 2 3 4 6 7 8) (iset->list (iset 1 2 3 4 6 7 8)))
(test '(1 2 3 4 5 7 8) (iset->list (iset 1 2 3 4 5 7 8)))
(test '(1 2 3 4 5 6 8) (iset->list (iset 1 2 3 4 5 6 8)))

(test '(1 2 3 4 5 6 7 8)
    (iset->list (iset-union (iset 1 2 3 4) (iset 5 6 7 8))))
(test '(1 3 4 5 6 7 8)
    (iset->list (iset-union (iset 1 3 4) (iset 5 6 7 8))))
(test '(1 2 4 5 6 7 8)
    (iset->list (iset-union (iset 1 2 4) (iset 5 6 7 8))))
(test '(1 2 3 5 6 7 8)
    (iset->list (iset-union (iset 1 2 3) (iset 5 6 7 8))))
(test '(1 2 3 4 6 7 8)
    (iset->list (iset-union (iset 1 2 3 4) (iset 6 7 8))))
(test '(1 2 3 4 5 7 8)
    (iset->list (iset-union (iset 1 2 3 4) (iset 5 7 8))))
(test '(1 2 3 4 5 6 8)
    (iset->list (iset-union (iset 1 2 3 4) (iset 5 6 8))))
(test '(1 2 3 6 7 8)
    (iset->list (iset-union (iset 1 2 3) (iset 6 7 8))))
(test '(1 3 6 8)
    (iset->list (iset-union (iset 1 3) (iset 6 8))))

(test '(1 2 3 4 1001 1002 1003 1004 2001 2002 2003 2004)
    (iset->list (iset-union (iset 1 2 3 4 1001 1002)
                            (iset 1003 1004 2001 2002 2003 2004))))
(test '(1 2 4 1001 1002 1003 1004 2001 2002 2003 2004)
    (iset->list (iset-union (iset 1 2 4 1001 1002)
                            (iset 1003 1004 2001 2002 2003 2004))))
(test '(1 2 3 4 1001 1002 1004 2001 2002 2003 2004)
    (iset->list (iset-union (iset 1 2 3 4 1001 1002)
                            (iset 1004 2001 2002 2003 2004))))
(test '(1 2 3 4 1001 1002 1003 1004 2001 2003 2004)
    (iset->list (iset-union (iset 1 2 3 4 1001 1002)
                            (iset 1003 1004 2001 2003 2004))))

(test-end)
